home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power CD-ROM!! 8
/
Power CD-ROM 8.iso
/
prgmming
/
maxlib10
/
detab.bas
< prev
next >
Wrap
BASIC Source File
|
1994-10-31
|
7KB
|
264 lines
$IF 0 '=================================================================
DETAB.BAS - A sample program showing how to use MAXLIB For PB.
Written by Brian McLaughlin. Released to public domain.
This is a simple utility for detabbing text files. You include the
name of the file to be detabbed on the command line, like so:
C:> DETAB \WORD\MYNAME\MYFILE.TXT
The original file keeps it's original name. The detabbed output
file is given the extension "DTB". (If the original file had a
"DTB" extension, the detabbed output is given the extension "$$$".)
DETAB.BAS assumes that tab stops are set every 8 spaces. You can
easily change that assumption. DETAB also trims any trailing
spaces from the end of each line.
DETAB.BAS could be improved in many ways to make it more useful. I
will leave that to you. It does demonstrate how to open a file,
read it, close it and do some rudimentary error handling. It also
shows how to write to STDOUT as a DOS device.
Before you compile DETAB.BAS, you must either place MAXLIB.PBL
and MAXLIB.BI into the current directory, or change the $LINK and
$INCLUDE statements to reflect their whereabouts.
$ENDIF '==================================================================
$LIB ALL OFF
$LINK ".\MAXLIB.PBL" ' <-- assumes file is in current directory
$INCLUDE ".\MAXLIB.BI" ' <-- assumes file is in current directory
DECLARE FUNCTION GetFileName$ ()
DECLARE FUNCTION MakeOutName$ (FileName$)
DECLARE SUB Detab (InFile$, OutFile$, TabWidth%)
DECLARE FUNCTION AllTrim$ (Target$)
DECLARE SUB HandleError ()
%TRUE = -1
%FALSE = 0
%STDOUT = 1
'/////////////////////// START OF MAIN \\\\\\\\\\\\\\\\\\\\\\\\\\
InitMAXFiles ' required!
SetDiskFile %FALSE ' make this value explicit
TabFile$ = GetFileName$ ' name returned as upper case
OutName$ = MakeOutName$(TabFile$) ' name returned as upper case
Report "Detabbing: " + TabFile$
TabWidth% = 8 ' set a default value for tab width
Detab TabFile$, OutName$, TabWidth%
Display$ = TabFile$ + " was successfully detabbed."
Report Display$
Display$ = "The detabbed output file is: " + OutName$
Report Display$
END
'///////////////////////// END OF MAIN \\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'==========================
FUNCTION GetFileName$
'==========================
Cmd$ = AllTrim$(COMMAND$)
IF LEN(Cmd$) THEN
IF LEN(DIR$(Cmd$)) THEN
InFile$ = UCASE$(Cmd$)
ELSE
Report "Can't find a file named: " + Cmd$
END
END IF
ELSE
Help$ = "To detab a file use: DETAB [path\]filename"
Report Help$
END
END IF
GetFileName$ = InFile$ 'name returned as upper case
END FUNCTION
'==================================
FUNCTION MakeOutName$ (FileName$)
'==================================
OutExtension$ = "DTB"
Dot% = INSTR(FileName$, ".") 'look for file extension
IF Dot% THEN
IF INSTR(FileName$, OutExtension$) = (Dot% + 1) THEN OutExtension$ = "$$$"
OutFile$ = UCASE$(LEFT$(FileName$, Dot%)) + OutExtension$
ELSE
OutFile$ = UCASE$(FileName$) + OutExtension$
END IF
MakeOutName$ = OutFile$
END FUNCTION
'==========================================================
SUB Detab (InFile$, OutFile$, TabWidth%)
'==========================================================
InHandle% = OpenX%(InFile$)
IF ErrorCode% THEN HandleError
IF LEN(DIR$(OutFile$)) THEN KillX OutFile$
IF ErrorCode% THEN HandleError
OutHandle% = OpenX%(OutFile$)
IF ErrorCode% THEN HandleError
TabChar$ = CHR$(9) 'initialize these outside the loop
CRLF$ = CHR$(13,10)
DO
ThisLine$ = GetLineX$(InHandle%)
IF ErrorCode% THEN HandleError 'this would end the program
IF LEN(ThisLine$) THEN
Start% = 1
DO
FoundTab% = INSTR(Start%, ThisLine$, TabChar$)
IF FoundTab% THEN
SpacesPastTabStop% = FoundTab% MOD TabWidth%
SpacesToAdd% = TabWidth% - SpacesPastTabStop%
INCR SpacesToAdd%
BeforeTab$ = LEFT$(ThisLine$, FoundTab% - 1)
AfterTab$ = MID$(ThisLine$, FoundTab% + 1)
ThisLine$ = BeforeTab$ + SPACE$(SpacesToAdd%)
Start% = LEN(ThisLine$)
ThisLine$ = ThisLine$ + AfterTab$
END IF
LOOP WHILE FoundTab%
OutString$ = RTRIM$(ThisLine$) + CRLF$ '<--NOTE: trims trailing spaces!
PutStX OutHandle%, OutString$
ELSE
PutStX OutHandle%, CRLF$
END IF
LOOP UNTIL EndX% OR ErrorCode%
IF ErrorCode% THEN HandleError
CloseX InHandle%
IF ErrorCode% THEN HandleError
CloseX OutHandle%
IF ErrorCode% THEN HandleError
END SUB
'=======================
SUB Report (Display$)
'=======================
CRLF$ = CHR$(13,10)
IF LEN(Display$) THEN
Display$ = " " + AllTrim$(Display$) + CRLF$
ELSE
Display$ = CRLF$
END IF
PutStX %STDOUT, Display$
END SUB
'=============================
FUNCTION AllTrim$ (Target$)
'=============================
AllTrim$ = RTRIM$(LTRIM$(Target$))
END FUNCTION
'====================
SUB HandleError
'====================
'This gives you a cut-and-paste skeleton for your own error handler:
Report "ERROR NUMBER:" + STR$(ErrorCode%)
SELECT CASE ErrorCode%
CASE -1
Report "Failed to allocate buffer string in GetLineX$."
CASE 2
Report "File not found."
CASE 3
Report "Path not found."
CASE 4
Report "Out of file handles."
CASE 5
Report "Access denied."
CASE 6
Report "Invalid file handle."
CASE 8
Report "Insufficient memory."
CASE 15
Report "Invalid drive."
CASE 19
Report "Write-protected disk."
CASE 21
Report "Drive not ready. Is drive door open?"
CASE 25
Report "Seek error."
CASE 26
Report "Unknown media type."
CASE 27
Report "Disk sector not found."
CASE 28
Report "Printer out of paper or not ready."
CASE 29
Report "Write fault."
CASE 30
Report "Read fault."
CASE 31
Report "General failure."
CASE 128
Report "Malfunction in EMM driver."
CASE 129
Report "Malfunction in EMS memory hardware."
CASE 131
Report "Invalid EMS handle."
CASE 132
Report "Invalid EMS function number."
CASE 133
Report "No EMS handles available."
CASE 134
Report "EMS deallocation error."
CASE 135
Report "Not enough EMS memory."
CASE 136
Report "More EMS pages requested than exist on system."
CASE 137
Report "Requested zero pages during EMS allocation."
CASE 138
Report "Tried to map a page not assigned to EMS handle."
CASE 139
Report "Invalid page frame number (not 0-3)."
CASE ELSE
Report "Unknown error."
END SELECT
END 'abort the program
END SUB